home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue25 / tu32 / TU32.ZIP / TU32Demo / BtchDemo / trepform.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1996-12-07  |  22.4 KB  |  778 lines
  1. unit Trepform;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Rebdlg, Verdlg, ExtCtrls, DB, DBTables,
  8.   DBGrids, DBIErrs, Tu, Buttons, Gauges;
  9.  
  10. type
  11.   TListFocus = (LBSelectFrom, LBMissing, LBNone);
  12.  
  13. type
  14.   TRepairForm = class(TForm)
  15.     Bevel1: TBevel;
  16.     Panel1: TPanel;
  17.     Label1: TLabel;
  18.     Label2: TLabel;
  19.     Label4: TLabel;
  20.     Label5: TLabel;
  21.     Label7: TLabel;
  22.     Label8: TLabel;
  23.     Label9: TLabel;
  24.     Label10: TLabel;
  25.     Label11: TLabel;
  26.     Label12: TLabel;
  27.     Label13: TLabel;
  28.     Label14: TLabel;
  29.     Label15: TLabel;
  30.     Label16: TLabel;
  31.     Label17: TLabel;
  32.     Label18: TLabel;
  33.     Label19: TLabel;
  34.     Label20: TLabel;
  35.     Label21: TLabel;
  36.     Label22: TLabel;
  37.     Label23: TLabel;
  38.     TUtilityVerReb: TTUtility;
  39.     ListBoxStatus: TListBox;
  40.     SaveDialogActivityLog: TSaveDialog;
  41.     ListBoxMissing: TListBox;
  42.     SelectFromLB: TListBox;
  43.     ComboBoxTblAlias: TComboBox;
  44.     ComboBoxBorrowAlias: TComboBox;
  45.     TableErrTable: TTable;
  46.     DataSource1: TDataSource;
  47.     GroupBoxVerify: TGroupBox;
  48.     GaugeIndex: TGauge;
  49.     GaugeHeader: TGauge;
  50.     GaugeData: TGauge;
  51.     LabelZeroOf: TLabel;
  52.     LabelOfZero: TLabel;
  53.     GaugeHeaderIdx: TGauge;
  54.     GaugeIndexIdx: TGauge;
  55.     GaugeDataIdx: TGauge;
  56.     GaugeIntegrity: TGauge;
  57.     GroupBoxRebuild: TGroupBox;
  58.     LabelNumPacked: TLabel;
  59.     GaugeRebuild: TGauge;
  60.     LabelRecSize: TLabel;
  61.     LabelNumFields: TLabel;
  62.     LabelNumRecs: TLabel;
  63.     LabelPasswordTF: TLabel;
  64.     LabelNumAuxPasswords: TLabel;
  65.     LabelTableOf: TLabel;
  66.     LabelOfTable: TLabel;
  67.     SpeedButtonAll: TSpeedButton;
  68.     SpeedButtonAllNone: TSpeedButton;
  69.     CheckBoxAltStructOnly: TCheckBox;
  70.     ButtonClose: TButton;
  71.     ButtonVerifyOnly: TButton;
  72.     ButtonViewErrTable: TButton;
  73.     ButtonFixAll: TButton;
  74.     butRebuild: TButton;
  75.     ButtonSaveLog: TButton;
  76.     procedure FormCreate(Sender: TObject);
  77.     procedure ButtonFixAllClick(Sender: TObject);
  78.     procedure TUtilityVerRebInfoRebuild(Sender: TObject;
  79.       RebuildCBRec: TRebuildCBData);
  80.     procedure TUtilityVerRebInfoVerify(Sender: TObject;
  81.       VerifyCBRec: TVerifyCBData);
  82.     procedure TUtilityRestInfoVerReb(Sender: TObject; AMessage: String;
  83.       Process: TUVerRebProcess; var Abort: Boolean);
  84.     procedure ButtonCloseClick(Sender: TObject);
  85.     procedure ButtonVerifyOnlyClick(Sender: TObject);
  86.     procedure ButtonSaveLogClick(Sender: TObject);
  87.     procedure ButtonViewErrTableClick(Sender: TObject);
  88.     procedure ComboBoxBorrowAliasChange(Sender: TObject);
  89.     procedure butRebuildClick(Sender: TObject);
  90.     procedure ComboBoxTblAliasChange(Sender: TObject);
  91.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  92.     procedure SelectFromLBClick(Sender: TObject);
  93.     procedure ListBoxMissingClick(Sender: TObject);
  94.     procedure SpeedButtonAllClick(Sender: TObject);
  95.     procedure SpeedButtonAllNoneClick(Sender: TObject);
  96.   private
  97.     { Private declarations }
  98.     CurProcess : TUVerRebProcess; {keep track of the rebuild or verify to eliminate screen flash}
  99.     TablesProcessed : Word;
  100.     fEditFilePattern : String;
  101.     fListFocus : TListFocus;
  102.     procedure ZeroGages;
  103.     procedure AssignBatchRec(TU : TTUtility; sList : TStrings; I : Word);
  104.     procedure SendToLog(aMsg : String);
  105.     procedure UpdateStats(TU : TTUtility; BatchList : TStrings);
  106.     procedure DeleteErrorTable;
  107.     procedure ReFillSelectFromLB;
  108.     function GetAliasPath(TheAlias : String) : String;
  109.     procedure ReDoBorrowList;
  110.     procedure SortList(aList : TStrings);
  111.   public
  112.     { Public declarations }
  113.     AliasPath,
  114.     AltPath : TFileName;
  115.     fTblAlias : TFileName;
  116.     fAltTblAlias : TFileName;
  117.     procedure ChangeListFocus(FocusList : TListFocus);
  118.   end;
  119.  
  120.  
  121.  
  122. var
  123.   RepairForm: TRepairForm;
  124.  
  125. implementation
  126.  
  127. {$R *.DFM}
  128.  
  129.  
  130. Procedure TRepairForm.ZeroGages;
  131. begin
  132.   GaugeHeader.Progress := 0;
  133.   GaugeIndex.Progress := 0;
  134.   GaugeData.Progress := 0;
  135.   GaugeHeaderIdx.Progress := 0;
  136.   GaugeIndexIdx.Progress := 0;
  137.   GaugeDataIdx.Progress := 0;
  138.   GaugeIntegrity.Progress := 0;
  139.   GaugeRebuild.Progress := 0;
  140.   LabelNumPacked.Caption := '';
  141.   LabelNumPacked.refresh;
  142. end;
  143.  
  144. Procedure TRepairForm.AssignBatchRec(TU : TTUtility;
  145.                                   sList : TStrings;
  146.                                       I : Word);
  147. VAR
  148.  s : string;
  149. begin
  150.   TU.TableName := '';
  151.   TU.tBkUpTableName := '';
  152.   TU.TableName      := AliasPath + '\' + sList.Strings[I];
  153.   if fileexists(AltPath + '\' + sList.Strings[I]) then
  154.   begin
  155.     TU.AltStructAlways := True;
  156.     TU.AltStructName  := AltPath + '\' + sList.Strings[I];
  157.   end
  158.   else
  159.   begin
  160.     TU.AltStructAlways := False;
  161.     TU.AltStructName := '';
  162.   end;
  163. end;
  164.  
  165. Procedure TRepairForm.SendToLog(aMsg : String);
  166. begin
  167.   With ListBoxStatus do
  168.   begin
  169.     Items.Add(AMsg);
  170.     { This next bit scrolls the text so the most recent msg is visible}
  171.     if (ItemHeight * Items.count) > Height then
  172.       TopIndex:= Items.count - (Height div ItemHeight) ;
  173.   end;
  174.   ListBoxStatus.Refresh;
  175. end;
  176.  
  177.  
  178. Procedure TRepairForm.UpdateStats(TU : TTUtility; BatchList : TStrings);
  179. Begin
  180.   If TU <> Nil then
  181.   begin
  182.     LabelNumRecs.Caption         := InttoStr(TU.TblInfo.iRecords);
  183.     LabelRecSize.Caption         := IntToStr(TU.TblInfo.iRecSize);
  184.     LabelNumFields.Caption       := IntToStr(TU.TblInfo.iFields);
  185.     LabelNumAuxPasswords.Caption := IntToStr(TU.TblInfo.iPasswords);
  186.     if TU.TblInfo.bProtected then
  187.       LabelPasswordTF.Caption := 'True'
  188.     else
  189.       LabelPasswordTF.Caption := 'False';
  190.     Inc(TablesProcessed);
  191.     if BatchList <> nil then
  192.     begin
  193.       LabelTableOf.Caption := IntToStr(TablesProcessed);
  194.       LabelOfTable.Caption := IntToStr(BatchList.Count);
  195.     end
  196.     else
  197.     begin
  198.       LabelTableOf.Caption := '';
  199.       LabelOfTable.Caption := '';
  200.     end;
  201.   end
  202.   else
  203.   begin
  204.     LabelNumRecs.Caption         := '0';
  205.     LabelRecSize.Caption         := '0';
  206.     LabelNumFields.Caption       := '0';
  207.     LabelNumAuxPasswords.Caption := '';
  208.     LabelPasswordTF.Caption := '';
  209.     LabelTableOf.Caption := '';
  210.     LabelOfTable.Caption := '';
  211.   end;
  212.   Panel1.Refresh;
  213. end;
  214.  
  215. procedure TRepairForm.DeleteErrorTable;
  216. Var
  217.   ErrTblName : String[255];
  218. begin
  219.   { make sure the error table is not active }
  220.   TableErrTable.Active := False;
  221.   TableErrTable.DatabaseName := Session.PrivateDir;
  222.   {Make sure the error table name has an extension }
  223.   if extractFileExt(TableErrTable.TableName) = '' then
  224.     ErrTblName := TableErrTable.TableName + '.DB'
  225.   else
  226.     ErrTblName := TableErrTable.TableName;
  227.   {if the error table  does not have a path then assign the private one}
  228.   if extractFilePath(TableErrTable.TableName) = '' then
  229.     ErrTblName := Session.PrivateDir + '\' + ErrTblName;
  230.   {Now delete the table if it exists}
  231.   if fileexists(ErrTblName) then
  232.     TableErrTable.DeleteTable;
  233. end;
  234.  
  235. procedure TRepairForm.FormCreate(Sender: TObject);
  236. begin
  237.   {Set get Database names}
  238.   fTblAlias := '';
  239.   fAltTblAlias := '';
  240. {***  ErrDlg := nil; }
  241.   AliasPath := GetAliasPath(fTblAlias);
  242.   AltPath   := GetAliasPath(fAltTblAlias);
  243.   {Set Get table names}
  244.   Session.GetDataBaseNames(ComboBoxTblAlias.Items);
  245.   Session.GetDataBaseNames(ComboBoxBorrowAlias.Items);
  246.   fEditFilePattern := '*.DB';
  247.   Session.GetTableNames(fTblAlias, fEditFilePattern, True, False, SelectFromLB.Items);
  248.   {Sort the list}
  249.   SortList(SelectFromLB.Items);
  250.   SelectFromLB.ItemIndex := -1;
  251.   ChangeListFocus(LBNone);
  252. end;
  253.  
  254. procedure TRepairForm.ButtonFixAllClick(Sender: TObject);
  255. var
  256.   aList : TStringList;
  257.   I : Integer;
  258.  
  259.   Procedure CreateListToProcess;
  260.   var
  261.     I : Integer;
  262.   begin
  263.     If SelectFromLB.Items.Count <= 0 then
  264.       exit;
  265.  
  266.     For I := 0 to SelectFromLB.Items.Count-1 do
  267.     begin
  268.       if SelectFromLB.Selected[I] then
  269.       begin
  270.         If CheckBoxAltStructOnly.Checked then
  271.         begin
  272.           if ListBoxMissing.Items.IndexOf(SelectFromLB.items.strings[I]) = -1 then
  273.           { this adds the qualified item to the temp list }
  274.             aList.Add(SelectFromLB.items.strings[I]);
  275.         end
  276.         else
  277.         begin
  278.           { this adds the qualified item to the temp list }
  279.           aList.Add(SelectFromLB.items.strings[I]);
  280.         end;
  281.       end;
  282.       {Record the fact that it was selected in the objects property}
  283.       SelectFromLB.Items.Objects[I] := TObject(Ord(SelectFromLB.Selected[I]));
  284.     end;{For}
  285.     SelectFromLB.MultiSelect := False;
  286.   end;
  287.  
  288.   Procedure ProcessList;
  289.   var
  290.     I : Integer;
  291.   begin
  292.     If aList.Count <= 0 then
  293.       exit;
  294.     For I := 0 to aList.Count-1 do
  295.     begin
  296.       try
  297.         SelectFromLB.ItemIndex := SelectFromLB.Items.IndexOf(aList.Strings[I]);
  298.         AssignBatchRec(TUtilityVerReb, aList, I);
  299.         UpdateStats(TUtilityVerReb, aList);
  300.         TUtilityVerReb.ExecuteVerifyRebuild;
  301.       except
  302.         {report the error to the log  so it doesn't stop the process}
  303.         on E:Exception do
  304.           SendToLog(E.Message);
  305.       end;
  306.       try
  307.         ZeroGages;
  308.       except
  309.       { report the error to the log  so it doesn't stop the process}
  310.         on E:Exception do
  311.           SendToLog(E.Message);
  312.       end;
  313.     end;
  314.     SelectFromLB.ItemIndex := -1;
  315.     ChangeListFocus(LBNone);
  316.   end;
  317.  
  318.  
  319. Begin
  320.   If CheckBoxAltStructOnly.Checked and
  321.      (ComboBoxBorrowAlias.ItemIndex = -1) then
  322.   begin
  323.     Application.MessageBox('You must select an Database Alias to borrow the structure from.',
  324.                '"Always Borrow Structure" Checked',
  325.                 MB_ICONHAND OR MB_OK);
  326.     ComboBoxBorrowAlias.SetFocus;
  327.     exit;
  328.   end;
  329.   ListBoxStatus.Setfocus;
  330.   CurProcess := TURebuilding;
  331.   GroupBoxVerify.Font.Color := clRed;
  332.   aList := TStringList.Create;
  333.   Try
  334.     ZeroGages;
  335.     TablesProcessed := 0;
  336.     CreateListToProcess;
  337.     ProcessList;
  338.   finally
  339.     sysutils.deletefile(TUtilityVerReb.tErrTableName);
  340.     { reselect the originally selected items }
  341.     SelectFromLB.MultiSelect := True;
  342.     For I := 0 to SelectFromLB.Items.Count-1 do
  343.       SelectFromLB.Selected[I] := Boolean(SelectFromLB.items.Objects[I]);
  344.     aList.Free;
  345.   end;
  346. end;
  347.  
  348. procedure TRepairForm.TUtilityVerRebInfoRebuild(Sender: TObject;
  349.   RebuildCBRec: TRebuildCBData);
  350. begin
  351.   with RebuildCBRec do
  352.   begin
  353.     if sMsg = '' then
  354.     begin
  355.       GaugeRebuild.Progress := iPercentDone;
  356.     end
  357.     else
  358.     begin
  359.       LabelNumPacked.Caption := sMsg;
  360.       LabelNumPacked.refresh;
  361.     end;
  362.   end;
  363. end;
  364.  
  365. procedure TRepairForm.TUtilityVerRebInfoVerify(Sender: TObject;
  366.   VerifyCBRec: TVerifyCBData);
  367. begin
  368.   with VerifyCBRec do
  369.   begin
  370.     Case Process of
  371.       TUVerifyTableName :;
  372.       TUVerifyHeader    : GaugeHeader.Progress := PercentDone;
  373.       TUVerifyIndex     : GaugeIndex.Progress := PercentDone;
  374.       TUVerifyData      : GaugeData.Progress := PercentDone;
  375.       TUVerifySXHeader  : GaugeHeaderIdx.Progress := PercentDone;
  376.       TUVerifySXIndex   : GaugeIndexIdx.Progress := PercentDone;
  377.       TUVerifySXData    : GaugeDataIdx.Progress := PercentDone;
  378.       TUVerifySXIntegrity :   {the index count and current index is passed by the TUVerifySXIntegrity Process}
  379.         begin
  380.           GaugeIntegrity.Progress := PercentDone;
  381.           LabelZeroOf.Caption := IntToStr(CurrentIndex);
  382.           LabelOfZero.Caption := IntToStr(TotalIndex);
  383.           LabelZeroOf.refresh;
  384.           LabelOfZero.refresh;
  385.         end;
  386.     end; {Case}
  387.   end;
  388. end;
  389.  
  390. procedure TRepairForm.TUtilityRestInfoVerReb(Sender: TObject;
  391.   AMessage: String; Process: TUVerRebProcess; var Abort: Boolean);
  392. begin
  393.   SendToLog(AMessage);
  394.   { use process to highlight the active panel in the status dialog }
  395.   if process <> CurProcess then
  396.   begin
  397.     Case Process of
  398.     TUVerifying  :
  399.       begin
  400.         GroupBoxVerify.Font.Color := clRed;
  401.         GroupBoxRebuild.Font.Color := clBlack;
  402.       end;
  403.     TURebuilding :
  404.       begin
  405.         GroupBoxVerify.Font.Color := clBlack;
  406.         GroupBoxRebuild.Font.Color := clRed;
  407.       end;
  408.     end; {case}
  409.     GroupBoxVerify.refresh;
  410.     GroupBoxRebuild.refresh;
  411.     CurProcess := Process;
  412.   end;
  413. end;
  414.  
  415. procedure TRepairForm.ButtonCloseClick(Sender: TObject);
  416. begin
  417.   Close;
  418. end;
  419.  
  420. procedure TRepairForm.ButtonVerifyOnlyClick(Sender: TObject);
  421. var
  422.   aList : TStringList;
  423.   I : Integer;
  424.  
  425.   Procedure CreateListToProcess;
  426.   var
  427.     I : Integer;
  428.   begin
  429.     If SelectFromLB.Items.Count <= 0 then
  430.       exit;
  431.     For I := 0 to SelectFromLB.Items.Count-1 do
  432.     begin
  433.       if SelectFromLB.Selected[I] then
  434.           aList.Add(SelectFromLB.items.strings[I]);
  435.       {Record the fact that it was selected in the objects property}
  436.       SelectFromLB.Items.Objects[I] := TObject(Ord(SelectFromLB.Selected[I]));
  437.     end;{For}
  438.     SelectFromLB.MultiSelect := False;
  439.   end;
  440.  
  441.  
  442.   Procedure ProcessList;
  443.   var
  444.     I : word;
  445.   begin
  446.     If aList.Count <= 0 then exit;
  447.     For I := 0 to aList.Count-1 do
  448.     begin
  449.       try
  450.         SelectFromLB.ItemIndex := SelectFromLB.Items.IndexOf(aList.Strings[I]);
  451.         SendToLog('Verifying Table           :' + aList.Strings[I]);
  452.         AssignBatchRec(TUtilityVerReb, aList, I);
  453.         UpdateStats(TUtilityVerReb, aList);
  454.         TUtilityVerReb.ExecuteVerify;
  455.         SendToLog('Verifying Status          : ' +
  456.            IntToStr(TUtilityVerReb.iErrorLevel));
  457.       except
  458.         {report the error to the log  so it doesn't stop the process}
  459.         on E:Exception do
  460.           SendToLog(E.Message);
  461.       end;
  462.       try
  463.         ZeroGages;
  464.         {now append all errors to the verify only error toble for reporting}
  465.         if fileexists(TUtilityVerReb.tErrTableName) then
  466.           TUtilityVerReb.Options := [vTU_Append_Errors];
  467.       except
  468.       { report the error to the log  so it doesn't stop the process}
  469.         on E:Exception do
  470.           SendToLog(E.Message);
  471.       end;
  472.     end;
  473.     SelectFromLB.ItemIndex := -1;
  474.     ChangeListFocus(LBNone);
  475.   end;
  476.  
  477. begin
  478.   ListBoxStatus.Setfocus;
  479.   CurProcess := TUVerifying;
  480.   GroupBoxVerify.Font.Color := clRed;
  481.   TablesProcessed := 0;
  482.   aList := TStringList.Create;
  483.   Try
  484.     ZeroGages;
  485.     SendToLog('STARTING VERIFY ONLY PROCESSING OF THE BATCH');
  486.     TUtilityVerReb.Options := [];
  487.     CreateListToProcess;
  488.     ProcessList;
  489.     ChangeListFocus(LBNone);
  490.   finally
  491.     SendToLog('VERIFY ONLY PROCESSING - COMPLETE');
  492.     { reselect the originally selected items }
  493.     SelectFromLB.MultiSelect := True;
  494.     For I := 0 to SelectFromLB.Items.Count-1 do
  495.       SelectFromLB.Selected[I] := Boolean(SelectFromLB.items.Objects[I]);
  496.     aList.Free;
  497.   end;
  498. end;
  499.  
  500. procedure TRepairForm.ButtonSaveLogClick(Sender: TObject);
  501. begin
  502.    if SaveDialogActivityLog.Execute then
  503.    begin
  504.      ListBoxStatus.Items.SaveToFile(SaveDialogActivityLog.FileName);
  505.      if MessageDlg('Do you want to clear the message log?', mtConfirmation,
  506.         [mbYes, mbNo], 0) = mrYes then
  507.         ListBoxStatus.Items.Clear;
  508.    end;
  509. end;
  510.  
  511.  
  512. procedure TRepairForm.SortList(aList : TStrings);
  513. var
  514.   TmpStr : String;
  515.   I, S, Dest : Integer;
  516. begin
  517.   Dest := aList.Count - 1;
  518.   While Dest > 0 do
  519.   begin
  520.     S := 0;
  521.     { Find the highest value in column 1 that hasn't been sorted yet}
  522.     For I := 0 to Dest do
  523.     begin
  524.       if AnsiCompareText(aList.Strings[S], aList.Strings[I])< 0 then
  525.          S := I;
  526.     end;
  527.     { Now move the highest value into the destination, destination goes where source was}
  528.     If S <> Dest then
  529.     begin
  530.       TmpStr := aList.Strings[S];
  531.       aList.Strings[S] := alist.Strings[Dest];
  532.       alist.Strings[Dest] := TmpStr;
  533.     end;
  534.     Dec(Dest);
  535.   end;
  536. end;
  537.  
  538. procedure TRepairForm.ButtonViewErrTableClick(Sender: TObject);
  539. var
  540.   ErrDlg : TForm;
  541.   OKBtn: TBitBtn;
  542.   PanelRed: TPanel;
  543.   DBGridViewErr: TDBGrid;
  544. begin
  545.   {Hand make Error Form so no DFM no additional DFM is needed}
  546.   TableErrTable.Active := False;
  547.   TableErrTable.DatabaseName := Session.PrivateDir;
  548.   ErrDlg := TForm.Create(Application);
  549.   Try
  550.     {Create the shell form and set its properties }
  551.     ErrDlg.BorderIcons := [biSystemMenu,biMinimize,biMaximize];
  552.     ErrDlg.BorderStyle := bsDialog;
  553.     ErrDlg.Caption := 'Verify Report';
  554.     ErrDlg.ClientHeight := 322;
  555.     ErrDlg.ClientWidth := 488;
  556.     ErrDlg.Height := 355;
  557.     ErrDlg.Position := poScreenCenter;
  558.     ErrDlg.Scaled := True;
  559.     ErrDlg.Width := 496;
  560.     {Add the OK button an set its properties}
  561.     OKBtn := TBitBtn.Create(Nil);
  562.     ErrDlg.InsertComponent(OKBtn);
  563.     ErrDlg.InsertControl(OKBtn);
  564.     OKBtn.Left      := 194;
  565.     OKBtn.Top       := 284;
  566.     OKBtn.Width     := 77;
  567.     OKBtn.Height    := 27;
  568.     OKBtn.Caption   := 'Close';
  569.     OKBtn.TabOrder  := 0;
  570.     OKBtn.Kind      := bkOK;
  571.     OKBtn.Margin    := 2;
  572.     OKBtn.Spacing   := -1;
  573.     {Add the Red Panel an set its properties}
  574.     PanelRed := TPanel.Create(Nil);
  575.     ErrDlg.InsertComponent(PanelRed);
  576.     ErrDlg.InsertControl(PanelRed);
  577.     PanelRed.Left := 4;
  578.     PanelRed.Top := 8;
  579.     PanelRed.Width := 481;
  580.     PanelRed.Height := 269;
  581.     PanelRed.BevelOuter := bvNone;
  582.     PanelRed.Color := clRed;
  583.     PanelRed.Ctl3D := False;
  584.     PanelRed.ParentCtl3D := False;
  585.     PanelRed.TabOrder := 1;
  586.     {Add the DBGrid an set its properties}
  587.     DBGridViewErr := TDBGrid.Create(Nil);
  588.     PanelRed.InsertComponent(DBGridViewErr);
  589.     PanelRed.InsertControl(DBGridViewErr);
  590.     DBGridViewErr.Left := 5;
  591.     DBGridViewErr.Top := 5;
  592.     DBGridViewErr.Width := 469;
  593.     DBGridViewErr.Height := 259;
  594.     DBGridViewErr.FixedColor := clRed;
  595.     DBGridViewErr.Options := [dgTitles, dgColumnResize, dgColLines,
  596.                              dgRowLines, dgTabs, dgConfirmDelete,
  597.                              dgCancelOnExit, TDBGridOption(25)];
  598.     DBGridViewErr.ReadOnly := True;
  599.     DBGridViewErr.TabOrder := 0;
  600.     DBGridViewErr.TitleFont.Color := clBlack;
  601.     DBGridViewErr.TitleFont.Height := -11;
  602.     DBGridViewErr.TitleFont.Name := 'MS Sans Serif';
  603.     DBGridViewErr.TitleFont.Style := [fsBold];
  604.     try
  605.       TableErrTable.Active := True;
  606.       ErrDlg.ActiveControl := OKBtn;
  607.       DBGridViewErr.DataSource := DataSource1;
  608.       ErrDlg.ShowModal;
  609.       { Deactivate Error Table }
  610.       TableErrTable.Active := False;
  611.     except
  612.       on E:EDBEngineError {10024} do
  613.       if E.errors[0].errorcode = 10024 then
  614.         MessageDlg('No error table exists.', mtInformation, [mbOK], 0);
  615.       else
  616.         raise;
  617.     end;
  618.   Finally
  619.     ErrDlg.Release;
  620.     ErrDlg := nil;
  621.   end;
  622. end;
  623.  
  624.  
  625. function TRepairForm.GetAliasPath(TheAlias : String) : String;
  626. var
  627.   StrList : TStringList;
  628.   I : Word;
  629. begin
  630.   result := '';
  631.   if TheAlias = '' then exit;
  632.   StrList := TStringList.Create;
  633.   Session.GetAliasParams(TheAlias, StrList);
  634.   For I := 0 to StrList.count-1 do
  635.     if pos('PATH=',StrList.Strings[I]) = 1 then
  636.     begin
  637.       result := copy(StrList.Strings[I], 6, 128);
  638.       break;
  639.     end;
  640.  
  641.   StrList.Free;
  642. end;
  643.  
  644. Procedure TRepairForm.ReFillSelectFromLB;
  645. begin
  646.   Session.GetTableNames(fTblAlias, fEditFilePattern,
  647.                          True, False, SelectFromLB.Items);
  648.   SortList(SelectFromLB.Items);
  649.   ListBoxMissing.Clear;
  650. end;
  651.  
  652. procedure TRepairForm.ComboBoxTblAliasChange(Sender: TObject);
  653. begin
  654.   with ComboBoxTblAlias do
  655.   begin
  656.     fTblAlias := Items.Strings[ItemIndex];
  657.     ReFillSelectFromLB;
  658.     AliasPath := GetAliasPath(Items.Strings[ItemIndex]);
  659.   end;
  660.   ChangeListFocus(LBNone);
  661. end;
  662.  
  663. procedure TRepairForm.ComboBoxBorrowAliasChange(Sender: TObject);
  664. begin
  665.   if ComboBoxBorrowAlias.ItemIndex <> -1 then
  666.   begin
  667.     fAltTblAlias :=  ComboBoxBorrowAlias.Items.Strings[ComboBoxBorrowAlias.ItemIndex];
  668.     ReFillSelectFromLB;
  669.     ChangeListFocus(LBNone);
  670.   end;
  671. end;
  672.  
  673. procedure TRepairForm.ReDoBorrowList;
  674. var
  675.   BorrowAliasTbls : TStringList;
  676.   I : Word;
  677. begin
  678.   ListBoxMissing.Clear;
  679.   if SelectFromLB.items.count = 0 then exit;
  680.   {Create a place to put the list of tables in the borrow alias}
  681.   BorrowAliasTbls := TStringList.Create;
  682.   Try
  683.     {Fill the temp list with the files in the Borrow from alias}
  684.     Session.GetTableNames(fAltTblAlias, fEditFilePattern,
  685.       True, False, BorrowAliasTbls);
  686.     {Find all the tables in the table List that are not also
  687.      in the Borrow from list and add them to the missing list}
  688.     For I := 0 to SelectFromLB.Items.Count - 1 do
  689.       if SelectFromLB.Selected[I] and
  690.            (BorrowAliasTbls.IndexOf(SelectFromLB.Items.Strings[I]) = -1) then
  691.         ListBoxMissing.Items.Add(SelectFromLB.Items.Strings[I]);
  692.     {Get the complete path to the Borrow from alias directory}
  693.     AltPath := GetAliasPath(ComboBoxBorrowAlias.Items.Strings[ComboBoxBorrowAlias.ItemIndex]);
  694.   finally
  695.     BorrowAliasTbls.Free;
  696.   end;
  697. end;
  698.  
  699. procedure TRepairForm.butRebuildClick(Sender: TObject);
  700. begin
  701.  TUtilityVerReb.AlwaysRebuild := True;
  702.  Try
  703.   ButtonFixAllClick(Sender);
  704.  Finally
  705.   TUtilityVerReb.AlwaysRebuild := False;
  706.  end;
  707. end;
  708.  
  709. procedure TRepairForm.FormClose(Sender: TObject; var Action: TCloseAction);
  710. begin
  711.   DeleteErrorTable;
  712. end;
  713.  
  714.  
  715. procedure TRepairForm.ChangeListFocus(FocusList : TListFocus);
  716.   procedure UpdateTableInfo(whichList : TListBox);
  717.   begin
  718.      AssignBatchRec(TUtilityVerReb, whichList.Items, whichList.ItemIndex);
  719.      UpdateStats(TUtilityVerReb, Nil);
  720.   end;
  721. begin
  722.   if FListFocus <> FocusList then
  723.     case fListFocus of
  724.       LBSelectFrom : SelectFromLB.ItemIndex := -1;
  725.       LBMissing    : ListBoxMissing.ItemIndex := -1;
  726.       LBNone :;
  727.     end; {case}
  728.   fListFocus := FocusList;
  729.   case fListFocus of
  730.     LBSelectFrom : UpdateTableInfo(SelectFromLB);
  731.     LBMissing    : UpdateTableInfo(ListBoxMissing);
  732.     LBNone       : UpdateStats(Nil, Nil);
  733.   end; {case}
  734. end;
  735.  
  736.  
  737. procedure TRepairForm.SelectFromLBClick(Sender: TObject);
  738. begin
  739.   ChangeListFocus(LBSelectFrom);
  740.   SortList(ListBoxMissing.Items);
  741.   SortList(SelectFromLB.Items);
  742.   ReDoBorrowList;
  743. end;
  744.  
  745. procedure TRepairForm.ListBoxMissingClick(Sender: TObject);
  746. begin
  747.   ChangeListFocus(LBMissing);
  748. end;
  749.  
  750. procedure TRepairForm.SpeedButtonAllClick(Sender: TObject);
  751. var
  752.   I : Integer;
  753. begin
  754.   For I := 0 to (SelectFromLB.Items.Count-1) do
  755.     SelectFromLB.Selected[I] := True;
  756.   if fListFocus = LBSelectFrom then
  757.      ChangeListFocus(LBNone);
  758.  ReDoBorrowList;
  759. end;
  760.  
  761. procedure TRepairForm.SpeedButtonAllNoneClick(Sender: TObject);
  762. var
  763.   I : Integer;
  764. begin
  765.   SelectFromLB.Clear;
  766.   ReFillSelectFromLB;
  767.   For I := 0 to (SelectFromLB.Items.Count-1) do
  768.   begin
  769.     SelectFromLB.Selected[I] := False;
  770.   end;
  771.   ChangeListFocus(LBNone);
  772. end;
  773.  
  774. end.
  775.  
  776.  
  777.  
  778.